00100	C  WORDS,  NAMEXT, TYPOUT
00200		
00300		SUBROUTINE WORDS
00400		INTEGER PWDS
00500		COMMON R2,JA,RC,J2,R3,R4,R5,R6,R7,X,IA,N
00600		1,Z,J,KN,ISET,KNT,Q(26),JR /PTR/PWDS(1)
00700		1 /LIMIT/LIMIT,ITEM,LL,IS,IX
00800	C  /SCX/ IS ALSO IN SCMSS, NOTBMS, RHYTH, BEAMS, NEWR(IN LOOP.FAI), SCAN.FAI
00900	C **** WHEN JALPHA IS EXTENDED FIX LOOP AT 365 AND SUBR. NEWR(IN LOOP)
01000	C **** AND SUBR. SCMSS, NOTBMS, RHYTH AND BEAMS
01100		COMMON/SCX/ICOM,MINUS,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON,
01200		1 ISEMI,IDBQT,IBLA,IDOL,IPRCNT,IANPR,IAT,INUM,LESS,IGT,IAPOS,
01300		1 IQUES,IEXCLA,LBRK,RBRK,UPAR,DNAR,DBLAR,SLA,XX,ZZ,
01400		1 J4,L,Y,K,RX,RZ,RA,J5  /XRN/RN(1) /ALF/INP(72),ML
01500		COMMON/SCN/KEL,KR,KU,KD,KSLA,NONO(30)
01600	CC	COMMON/SCN/LEL,LR,LU,LD,KSLA,LE,LC,LS,LF,LA,LI,LW
01700		DIMENSION IAZ(26),JALPHA(30)
01800		COMMON/A2Z/LA,LB,LC,LD,LE,LF,LG,LH,LI,LJ,LK,LEL,LM,
01900		1 LN,LO,LP,LQ,LR,LS,LT,LU,LV,LW,LX,LY,LZ
02000		EQUIVALENCE (ICOM,JALPHA),(INP2,INP(2)),(IAZ,LA)
02100		DATA LEL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/,KSLA/'/'/
02200		1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/
02300		DATA IAZ/'A','B','C','D','E','F','G','H','I','J','K','L','M',
02400		1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/ 
02500		DATA JALPHA/',','-','.','=','(',')','+','*',':',';'
02600		1 ,'"',' ','$','%','&','@','#','<','>',1H','?','!'
02700		1 ,"555004020100,"565004020100,"571004020100,"5004020100,
02800		1 "135004020100,'/','[',']'/
02900	C   FOR ENTERING TEXT: T, POS., STF., NT#., SIZE,  RHYTHM≠0
03000	C NOT ANY LONGER****** R6 ≠0 CALLS NOTE NUM. SETUP
03100	CXX	JR=-1
03200		KNT=-1
03300	C COUNTER FOR SEPARATE TEXT ITEMS.
03400	CC	IF(R3.NE.999)GO TO 131
03500	CXX	IF(INP2.NE.LF)GO TO 131
03600	C TYPE 'TF n,n,n,n' TO READ TYPEIN FROM A FILE.
03700	CXX	CALL TYPSTR('TYPE FILE NAME-- ')
03800	CCC	TYPE 331
03900	CXX	ACCEPT 631,KN
04000	CXX	IF(LOOK(KN).EQ.0)RETURN
04100	CXX	R2=R3
04200	CXX	R3=R4
04300	CXX	R4=R5
04400	CXX	R5=R6
04500	C  'TF' PUSHES PARAM LIST ONE NOTCH TO RIGHT.
04600	C  GO BACK IF NO FILE FOUND.  READS ONLY FILES WITH NO DIRECTORY.
04700	CXX	CALL IFILE(21,KN)
04800	CXX	READ(21,431)INP
04900	CXX	JR=0 
05000	CC	R6=1
05100	CXX	GO TO 531
05200	CXX631	FORMAT(A5)
05300	CCC331	FORMAT(' TYPE FILE NAME-- '$)
05400	431	FORMAT(72A1)
05500	131	CALL TYPE
05600	531	DO 31 KN=72,1,-1
05700	31	IF(INP(KN).NE.IBLA)GO TO 33
05800	C  KN=NUM OF CHARACTERS
05900	C  DON'T END WITH '*' IN 'LETTERS' INPUT!!!!!!!!
06000	C  , - . = ( ) + * : ; " BLANK (FONTS) ' --THIS IS ORDER PAST ALPHAB.
06100	C [=QTR NOTE, ]=HALF NOTE, ↑=#, ↓=b, ↔=NATURAL, 3 SLOTS STILL OPEN
06200	
06300	C  50 &=NON-ITALICS(BDR), 51 @=ITALICS(BDI)
06400	C  48 &&=BDL (LIGHT-FACE)     49 IS STILL FREE ****
06500	C  52 #=RETURN TO PRIMITVE FONT, 53 <=OPEN, 54 >=FILLED. ('=55)
06600	C FRENCH ACCENTS=ACCUTE=64, GRAVE=65, CMFLX=66, UMLT=67, CIDLA=68, 69 FREE.
06700	C                 <<          >>       $$        %%       ##
06800	33	L=1
06900		RC=0
07000		IF(INP(KN).NE.KSLA)GO TO 333
07100		IF(INP(KN+1).NE.KSLA)GO TO 133
07200	C  TYPE // TO PRINT A SINGLE SLASH.  (NO SPACE BETWEEN!)
07300	333	KN=KN+1
07400		INP(KN)=KSLA
07500	C  SO TRAILING BLANKS ARE DELETED.
07600	133	LL=1
07700		RZ=0 
07800		ISET=IS
07900		IF(R3.LT.1000)GO TO 233
08000		RZ=1
08100		R3=R3-1000.
08200		RC=R3
08300	C  ADD 1000 TO POSITION (R3+1000) FOR CENTERING AT POS. R3.
08400	233	RA=R3
08500	C   RA= ADDS UP TOTAL SPACE NEEDED
08600		RX=0
08700	C  FOR SETLET
08800	368	RN(IS+1)=16
08900		RN(IS+3)=RA
09000	C  NEXT IS A MAGIC NUMBER FOR SPACING LETTERS.
09100	CC	Y=39.6*RSTJ3
09200	C  RBL IS FOR CONTROL(NON-LETTERS, ETC.) CHARACTERS.
09300		RN(IS+2)=R2
09400		RN(IS+4)=R4
09500		CALL NOZERO(R5)
09600		RN(IS+5)=R5
09700		IF(R5.GE.100)R5=R5-100
09800	C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP. PARTS.
09900	CKK	KK=0
10000		DO 364 J5=6,8
10100		Z=0
10200		DO 363 J4=1,4
10300	361	IA=INP(L)
10400		IF(IA.NE.KSLA)GO TO 365
10500	C  NEG. SPACE IS ENTERED IN P1 FOR EACH "FIRST" ITEM.
10600		IF(INP(L+1).NE.KSLA)GO TO 433
10700	C  TYPE // TO PRINT A SINGLE SLASH.  (NO SPACE BETWEEN!)
10800	CKK	KK=KK+1
10900		L=L+1
11000		GO TO 365
11100	433	J3=J4
11200		DO 367 KA=J5,8
11300		X=99.
11400		DO 366 K=J3,4
11500		Z=Z+X
11600	366	X=X*100.0
11700		RN(IS+KA)=Z
11800		J3=1
11900	367	Z=0
12000		L=L+1
12100	C  L=CHARACTER COUNTER
12200		GO TO 369
12300	365	DO 362 J=1,30
12400		IF(IA.NE.JALPHA(J))GO TO 362
12500		N=35+J
12600	C  FOUND A SPECIAL CHARACTER.
12700		K=N
12800		IFNT=0
12900		IF(N.LT.48)GO TO 39
13000		IF(N.GT.54)GO TO 39
13100		IF(IA.NE.INP(L+1))GO TO 39
13200	C NEXT FOR DBL CHARS.
13300		GO TO(1,2,3,39,7,4,5)N-47
13400	C FOR FRENCH ACCENTS
13500	1	N=66
13600	CIRCUMFLEX   TYPE $$
13700		GO TO 6
13800	2	N=67
13900	C UMLAUT   TYPE %%
14000		GO TO 6
14100	3	N=48
14200	C &&=BDL40 FONT
14300		GO TO 6
14400	4	N=64
14500	C ACCUTE  TYPE >>
14600		GO TO 6
14700	7	N=68
14800	C CEDILLA  TYPE ##
14900		GO TO 6
15000	5	N=65
15100	C GRAVE  TYPE <<
15200	CC	IF(N.NE.50)GO TO 39
15300	CC	IF(IA.NE.INP(L+1))GO TO 39
15400	6	K=N
15500		L=L+1
15600	C  TYPE && FOR LIGHT-FACE (BDL).  PUSH PTR (L) ALONG 1 MORE.
15700		GO TO 39
15800	362	CONTINUE
15900	38	N=10-(LA-INP(L))/536870912
16000	C   MAGIC NUMBER TO FIND LETTERS
16100		IF(N.LT.10)N=N+7
16200		K=N
16300		IF(KFNT)IFNT=0
16400		IF(N.LT.40)GO TO 39
16500		N=N+28
16600		KFNT=-1
16700	C  TO INITIALIZE AUTOMATIC LOWER CASE SYSTEM.
16800		K=N-60
16900	C  K IS ACTUAL LETTER NUMB. (a=10, ETC.)
17000		IFNT=-1
17100	C LOWER CASE LETTERS ARE 60 .GT. UPPER. A=10, a=70, b=71, etc.
17200	39	L=L+1
17300	C  BLANK=47  =99 WHEN NO MORE CHARS TO COME.
17400		IF(N.LT.63.OR.N.GT.68)CALL SPACER(K,IFNT,RX,3.32)
17500	C  NUM↑↑=19.7/5.96  FOR BASIC SPACE PER LETTER.
17600	C  GET SPACE FOR THIS LETTER.  IGNORE ACCENTS (63-68)
17700		X=N
17800		IF(J4.EQ.2)X=X*10000.
17900		IF(J4.EQ.3)X=X*100.
18000		IF(J4.EQ.1)X=X*1000000.
18100	363	Z=Z+X
18200	364	RN(IS+J5)=Z
18300	369	RN(IS+9)=RX
18400		RN(IS+10)=RZ
18500		IF(RZ.EQ.0)KNT=KNT+1
18600		IF(RC.NE.0)RN(IS+10)=RC
18700		RC=0
18800	C  FOR CONTINUATION
18900		RA=RA+RX*R5
19000		IF(IA.EQ.KSLA)RA=RA+5
19100	C  SPACES GROUPS DIVIDED BY SLASHES
19200		RX=0
19300		IF(RZ.NE.0)GO TO 370
19400	C  SKIP IF P10=1, REQUIRED FOR CONTINUATION OF TEXT.
19500		IF(IBLANK(IS,7))RZ=-2
19600	C IF LAST CHAR IN P7 IS BLANK RESET WDCNT, GET RID OF P8 AND P9
19700		IF(IBLANK(IS,6))RZ=-3
19800	C ↑↑↑↑ LAST CHAR IN P6=BLNK ZAPS P7 IF NOT NEEDED. RZ=- CHANGES WORDCNT
19900	370	RN(IS)=7+RZ
20000		IS=IS+10+RZ
20100		LL=LL+1
20200		PWDS(ITEM+LL)=IS
20300	C  PUT IT IN THE PNTR ARRAY
20400		RZ=1.
20500		IF(IA.EQ.KSLA)RZ=0
20600		IF(L.LT.KN)GO TO 368
20700	C   WAS ↑↑↑↑↑↑↑ .LE.    5/22/76
20800	
20900		IF(KNT.GT.0)CALL SETLET
21000	C  GOES TO SETLET AUTOMATICALLY IF MORE THAN ONE SLASH FOUND.
21100		IF(KFNT)IFNT=0
21200		KFNT=0
21300		INP(1)=0
21400	C   SO IT WON'T FIND A COMMAND IN THE MAIN PROG.
21500		END
21600	C  PACKS 4 CHARS/WD, 3 WDS/ITEM.
21700	
21800	CC	SUBROUTINE NAMEXT(JA,NAME,IEXT)
21850		SUBROUTINE DUMMY
21900		COMMON /MKX/MKX(7),PRNL
22000		DIMENSION JA(1),A(5),FM(7)
22100		DATA A/'A1','A2','A3','A4','A5'/,FM(1)/'('/
22200		EQUIVALENCE (A5,A(5)),(FM2,FM(2)),(FM3,FM(3)),(FM4,FM(4)),
22300		1 (FM5,FM(5)),(FM6,FM(6)),(FM7,FM(7)),(A3,A(3))
22400		DO 9 K=2,7
22500	9	FM(K)=' '
22600		ID=0
22700		IA=0
22800		NAME=' '
22900		DO 1 K=20,1,-1
23000		IF(JA(K).EQ.' ')GO TO 1
23100	5	DO 2 L=K-1,1,-1
23200		J=JA(L)
23300		IF(J.NE.' ')GO TO 3
23400		IA=L
23500		GO TO 4
23600	3	IF(J.NE.'.')GO TO 2
23700		ID=L
23800		K=L
23900	C '.' ASSUMES THERE IS AN EXTENSION 
24000		GO TO 5
24100	2	CONTINUE
24200		GO TO 4
24300	1	CONTINUE
24400	C ALL BLANK IF WE GET HERE
24500		RETURN
24600	4	IF(IA.NE.0)GO TO 6
24700		IF(JA(1).EQ.-1)RETURN
24800	C  ↑↑↑ FOR 'RS', 'SA', 'G', ETC. WITH NO NAME FOLLOWING.
24900		IF(ID.NE.0)GO TO 7
25000	C NOW ONLY A NAME IS ON THIS LINE
25100		FM2=A5
25200		FM3=PRNL
25250	C GET LEFT PARENTHESIS
25300		REREAD FM,NAME
25400		GO TO 10
25500	7	FM3=',A1,'
25600		FM2=A(ID-1)
25700		FM4=A3
25800		FM5=PRNL
25900	C  FOUND NAME AND EXTENSION
26000		REREAD FM, NAME,K,IEXT
26100		GO TO 11
26200	6	IF(IA.GT.5)RETURN
26300	C .GT.5 = TOO MUCH IN FRONT OF NAME!!
26400		FM2=A(IA)
26500		FM3=','
26600		IF(ID.NE.0)GO TO 8
26700		FM4=A5
26800		FM5=PRNL
26900	C  FOUND  'WORD', NAME    WORD= SA, RS, GM, ETC.
27000		REREAD FM,K,NAME
27100		GO TO 10
27200	8	FM4=A(ID-IA-1)
27300		FM5=',A1,'
27400		FM6=A3
27500		FM7=PRNL
27600		REREAD FM,K,NAME,K,IEXT
27700	11	CALL LO2UP(IEXT)
27800	10	CALL LO2UP(NAME)
27900		END
28000	
28100		SUBROUTINE TYPOUT
28200		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,
28300		1 JX,ISM,IQ,VX(50),IMP,K,KN,M,MD,IBLA /ALF/INP(72) /IDEV/IDEV
28400		IF(IDEV.NE.5)RETURN
28500		DO 1 KK=72,1,-1
28600	1	IF(INP(KK).NE.IBLA)GO TO 2
28700	2	CALL TYPINT(MODE)
28800		CALL TYPCHR('   ',3)
28900		DO 3  KKK=1,KK
29000	3	CALL TYPCHR(INP(KKK),1)
29100		CALL TYPCRLF
29200		END
29300	
29400		SUBROUTINE PACKX(NAM,KNM)
29500		DIMENSION KNM(5)
29600		DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
29700		1 , MM/"774000000000/
30000		NAM=0
30100		DO 12 K=5,1,-1
30200		NAM=NAM .OR. (KNM(K) .AND. MM)
30300		IF (K.EQ.1)RETURN
30400	17	IF (NAM.GE.0)GO TO 13
30500		NAM = (( NAM .AND. LL)/KK) .OR. JJ
30600		GO TO 12
30700	13	NAM = NAM / KK
30800	12	CONTINUE
30900		RETURN
31000		END
31100	
31200		SUBROUTINE NAMEXT(I,NAME,IEXT)
31300	C FINDS NAME.EXT IN A1 STRING
31400		DIMENSION I(1)
31500	
31510		IF(I(1).NE.-1)GO TO 9
31600	C FIRST PASS UP 'G', 'GM', 'RS', ETC.  (=-1)
31700		DO 1 K=1,72
31800	1	IF(I(K).EQ.' ')GO TO 2
31900	C NOW PASS BLANKS
32000	2	J=72
32050		DO 3 J=K+1,72
32100	3	IF(I(J).NE.' ')GO TO 4
32200	C NOW FOUND START OF WORD (UNLESS ALL BLANKS)
32300	4	IF(J.NE.72)GO TO 5
32400		NAME=' '
32600		RETURN
32610	9	J=1
32700	5	DO 6 K=J,72
32800		IF(I(K).EQ.' ')GO TO 7
32900	C JUMP IF NAME ONLY
33000	6	IF(I(K).EQ.'.')GO TO 8
33100	7	CALL PACKX(NAME,I(J))
33200		RETURN
33250	8	CALL RLOOP(I(61),I(J),K-J)
33600		CALL PACKX(NAME,I(61))
33700		CALL PACKX(IEXT,I(K+1))
33800		END